perm filename TEST[E,ALS]19 blob
sn#279484 filedate 1977-04-29 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ∂3/8/77 -- E can now be in any one of three possible reporting states.
C00006 00003 THIS IS A TITLE LINE
C00008 00004 TLO F,NOCHK Don't CORE DOWN untill through
C00011 00005 MKROOM INSERT FULL DELETE ADD CORRECT NICK REPORT UPDATE GAME
C00028 00006 $CLASS FATAL NONFATAL CATCRLF OPENFILE USETOUT USETIN BK!PRV
C00045 ENDMK
C⊗;
∂3/8/77 -- E can now be in any one of three possible reporting states.
The reporting state determines how much information E types out at various
times.
The three states are: the normal default state, a verbose state achieved
by the command ⊗XVERBOSE and a terse state achieved by the command
⊗XTERSE.
The normal state can be restored by giving either ⊗-⊗XVERBOSE or
⊗-⊗XTERSE.
You can find out the current state by giving either ⊗0⊗XVERBOSE or
⊗0⊗XTERSE.
The normal state now does somewhat less reporting (that is, less typeout)
than formerly, especially for the parenthesis commands.
However, a new command ⊗XPINFO has been added to give you the details of
the last parenthesis command (or use ⊗XVERBOSE).
No error messages are ever suppressed by the terse state.
The following remarks are currently suppressed in the Terse state:
Only one MARK and you are there!
There are no marks!
Already marked!
Not marked!
All marks have been cleared.
Removing last MARK on this page.
MARKS on this page only have been cleared.
Macro ended. (normal end) Page is empty.
(XNDFAIL, XNDSAIL cmds) The following remarks are currently suppressed in
Terse and Normal states:
N characters added/removed (justify commands) Line now has N chars. (join)
You have replaced XXX with YYY (substitute) (detailed reporting of the
parenthesis commands--use new ⊗XPINFO) The new line of N chars lists M
items (new directory line commands) Suggestions other informational
remarks to suppress will be accepted.
∂3/8/77 -- Reporting of FIND and related commands has been augmented to
show "(observing case)" or "(ignoring case)" depending on the state of the
EXACT switch.
The fact that the search was for a delimited string is now indicated by
the use of "|" instead of the usual "\" delimiters (which are still used
for an undelimited string search).
Furthermore, a zero argument to any of the Find or Substitute commands
(⊗0⊗F, ⊗0⊗XFIND, ⊗0⊗*, ⊗0⊗\) will simply cause the search and/or
THIS IS A TITLE LINE
The XSJF command should separate sentences and respect blank lines as well
as punctuation for ending a sentence. This will be used to test this.
TLO F,NOCHK ;Don't CORE DOWN untill through
; TRO F,UPDTXT ;This is the first line on the page
HRRZ H,FSEND
ADDI H,1
ABC DEF
GHI
This is a title line
The text follows. This should start a new line. And this also.
COMMENT MKROOM INSERT FULL DELETE ADD CORRECT NICK REPORT UPDATE GAME
TEAMS NLIST GLIST LIKELY;
PROCEDURE MKROOM;
⊂
LABEL MKRO1;
MKRO1: IF BUF[I]≠0 THEN
⊂ FOR K←I STEP SIZE UNTIL 1008 DO IF BUF[K]=0 THEN DONE;
IF K≥1008 THEN OUTSTR("Too many players! ") ELSE
⊂ FOR K←K-1 STEP -1 UNTIL I DO BUF[K+SIZE]←BUF[K];
FOR K←I+SIZE-1 STEP -1 UNTIL I DO BUF[K]←0;
⊃ ;
⊃ ;
⊃ ;
PROCEDURE INSERT; $ To add new name to list;
⊂
LABEL INSER1;
INSER1: BUF[I]←CVSIX(READX);
⊃ ;
PROCEDURE FULL;
⊂ OUTSTR('11&"Type full name for record "); READ3←INCHWL; J←1;
READ3←READ3&" "; $ Pad it out by 12 blanks;
FOR K←2 STEP 1 UNTIL 5 DO ⊂ BUF[I+K]←CVASC(READ3[J FOR 5]); J←J+5; ⊃ ;
BUF[I+6]←0; BUF[I+7]←10000;
⊃ ;
PROCEDURE DELETE; $ Delete name from list;
⊂ GET;
FIND;
IF I≠J THEN OUTSTR("Not found"&'15&'12) ELSE
⊂ OUTSTR("Do you really want to delete "&CVXSTR(BUF[I]));
OUTSTR('11);
FOR J←4 STEP 1 UNTIL 7 DO OUTSTR(CVSTR(BUF[I+J]));
OUTSTR("? ");
READY←(INCHWL)[1 for 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN
FOR J←I STEP 1 UNTIL 999 DO
BUF[J]←BUF[J+SIZE];
⊃ ;
⊃ ;
PROCEDURE ADD;
⊂ "ADD" $ Returns index in I for location of nickname;
WHILE TRUE DO
⊂ "TLOOP"
GET;
IF LENX=0 THEN DONE "TLOOP";
FIND;
IF I>J THEN ⊂ MKROOM; INSERT; FULL; ⊃ ;
IF I=J THEN OUTSTR ("This nickname has already been used"&'15&'12);
⊃ "TLOOP";
⊃ "ADD";
PROCEDURE CORRECT;
⊂ "CORRECT"
WHILE TRUE DO
⊂ "TLOOP"
OUTSTR("Type old ");
GET;
IF LENX=0 THEN DONE "TLOOP";
FIND;
IF J≠I THEN ⊂ OUTSTR("Ambiguous, try again."&'15&'12); CONTINUE; ⊃ ELSE
⊂ OUTSTR (" for ");
FOR K←2 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[I+K]));
OUTSTR ('15&'12&"CR or corrected nickname ");
GET;
IF LENX≠0 THEN INSERT;
OUTSTR("CR or correct full name ");
READ3←INCHWL;
IF ¬EQU(READ3,"") THEN
⊂ READ3←READ3&" "; $ Pad it out by 12 blanks;
FOR K←2 STEP 1 UNTIL 5 DO ⊂ BUF[I+K]←CVASC(READ3[J FOR 5]); J←J+5; ⊃ ;
⊃ ;
OUTSTR("Has played "&CVS(BUF[I+6])); OUTSTR(" games. CR or correct ");
READ2←INCHWL; IF LENGTH(READ2)≠0 THEN BUF[I+6]←CVD(READ2);
RATING←BUF[I+7]; RATING←RATING/100-100;
OUTSTR("With a rating of "&CVF(RATING)&" CR or correct ");
READ4←INCHWL; IF (LENGTH(READ4))>0 THEN
⊂ READX←""; READP←"."; READC←",";
FOR K←1 STEP 1 UNTIL 3 DO
⊂ READ5←LOP(READ4); IF EQU(READ5,READP)∨EQU(READ5,READC) THEN DONE;
READX←READX&READ5;
⊃ ;
IF EQU(READ5,READC) THEN READX←READX&"00" ELSE
⊂ READX←READX&READ5;
READ4←LOP(READ3);
IF EQU(READ4,READC) THEN READ4←"0";
READX←READX&READ4;
⊃ ;
BUF[I+7]←CVD(READX);
⊃ ;
⊃ ;
⊃ "TLOOP";
⊃ "CORRECT";
PROCEDURE NICK;
⊂ READ1←READ2←READ3←"";
IF I≥SIZE THEN FOR J←2 STEP 1 UNTIL 5 DO READ1←READ1&CVSTR(BUF[I-SIZE+J]);
FOR J←2 STEP 1 UNTIL 5 DO READ2←READ2&CVSTR(BUF[I+J]);
IF ¬ EQU(BUF[I+SIZE+2],"") THEN
FOR J←2 STEP 1 UNTIL 5 DO READ3←READ3&CVSTR(BUF[I+SIZE+J]);
FOR K←1 STEP 1 UNTIL 20 DO
⊂ L←LOP(READ1); M←LOP(READ2); N←LOP(READ3);
⊃ ;
⊃ ;
PROCEDURE REPORT;
⊂ "REPORT"
LABEL REP1,REP2,REP3,REP4;
I←J←0; NDATA[J]←I; RDATA[J]←BUF[I+7];
OUTSTR('15&'12&
"Rating Nickn. Played on With Against With earlier"&'15&'12);
REP1: FOR I←SIZE STEP SIZE UNTIL 1008 DO
⊂ IF BUF[I]=0 THEN DONE; L←I%SIZE;
NDATA[L]←I; RDATA[L]←BUF[I+7];
REP2: FOR J←L STEP -1 UNTIL 1 DO
⊂ IF RDATA[J]≤RDATA[J-1] THEN DONE;
REP3: K←NDATA[J]; NDATA[J]←NDATA[J-1]; NDATA[J-1]←K;
K←RDATA[J]; RDATA[J]←RDATA[J-1]; RDATA[J-1]←K;
⊃ ;
⊃ ;
REP4: FOR K←0 STEP 1 UNTIL L DO
⊂ I←NDATA[K]; IF BUF[I]=0 THEN DONE;
RATING←BUF[I+7]; RATING←(RATING/100)-100;
OUTSTR('15&'12&CVF(RATING));
OUTSTR('11&CVXSTR(BUF[I]));
OUTSTR('11);
OUTSTR(CVXSTR(BUF[I+18]));
OUTSTR('11); QQ←0;
FOR J←8 STEP 1 UNTIL 11 DO
⊂ READB←CVXSTR(BUF[I+J]);
STRIP;
OUTSTR(READB[1 FOR Q]);
IF BUF[I+J+1]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
FOR Q←QQ STEP 1 UNTIL 11 DO OUTSTR(" "); OUTSTR(" "); QQ←0;
FOR J←12 STEP 1 UNTIL 17 DO
⊂ READB←CVXSTR(BUF[I+J]);
STRIP;
OUTSTR(READB[1 FOR Q]);
IF BUF[I+J+1]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
FOR Q←QQ STEP 1 UNTIL 17 DO OUTSTR(" "); OUTSTR(" ");
FOR J←20 STEP 1 UNTIL 23 DO
⊂ READB←CVXSTR(BUF[I+J]);
STRIP;
OUTSTR(READB[1 FOR Q]);
IF BUF[I+J+1]=0 THEN DONE; OUTSTR(",");
⊃ ;
⊃ ;
OUTSTR('15&'12&'12&'12);
⊃ "REPORT";
PROCEDURE UPDATE;
⊂
WHILE TRUE DO
⊂ GET;
FIND;
IF I>J THEN
⊂ OUTSTR('11&"Is this a new name to add? ");
READY←(INCHWL)[1 for 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN
⊂ MKROOM; INSERT; FULL; J←I; ⊃ ;
⊃ ;
IF I=J THEN
⊂ K←BUF[I+6]; L←BUF[I+7]; RATING←L; RATING←RATING/100-100;
OUTSTR (CVSTR(BUF[I+2])&CVSTR(BUF[I+3])&CVSTR(BUF[I+4])&CVSTR(BUF[I+5]));
SETFORMAT(1,0);
OUTSTR (" Game "&CVS(K+1));
SETFORMAT(3,2);
OUTSTR(" Rating was "&CVF(RATING));
RATING←((RATING*3)+DELTA)/4;
OUTSTR (" changed to "&CVF(RATING)&'15&'12);
RATING←(RATING+100)*100; L←RATING;
OUTSTR("Is this OK?"&'11);
READY←(INCHWL)[1 FOR 1];
IF EQU(READY,"Y")∨EQU(READY,"y") THEN
⊂ BUF[I+6]←BUF[I+6]+1; BUF[I+7]←L;
DATA[P]←BUF[I]; P←P+1;
DONE;
⊃ ELSE OUTSTR ("Sorry, try again ");
⊃ ;
⊃ ;
⊃ ;
PROCEDURE GAME;
⊂ "GAME"
INTEGER HH,JJ,JJJ;
LABEL GA0,GA1,GA2,GA3,GA4,GA5,GA6;
SETFORMAT(5,3);
OUTSTR('15&'12&'11&"Type date of game = ");
READD←INCHWL;
WHILE TRUE DO
⊂ OUTSTR('11&"Type score difference = ");
IF LENGTH((READ1←INCHWL))=0 THEN DONE;
DELTA2←DELTA←CVD(READ1);
OUTSTR('11&"Type number on each side = ");
SIDE←CVD(INCHWL);
DELTA←DELTA/SIDE;
OUTSTR('11&'11&"List winners by nickname"&'15&'12);
P←0;
GA0: FOR JJJ←1 STEP 1 UNTIL SIDE DO UPDATE;
DELTA←0-DELTA;
OUTSTR('15&'12&'11&'11&"Now list losers by nickname"&'15&'12);
FOR JJJ←1 STEP 1 UNTIL SIDE DO UPDATE;
$ Add to list of teams, testing cell containing SIDE for empty slot;
FOR J←2 STEP 12 UNTIL 1010 DO IF BUF2[J]=0 THEN DONE;
IF J>1010 THEN
⊂ FOR J←0 STEP 1 UNTIL 1007 DO BUF2[J]←BUF2[J+12];
FOR J←1008 STEP 1 UNTIL 1023 DO BUF2[J]←0;
J←1008;
⊃ ELSE J←J-2;
BUF2[J]←CVSIX(READD); BUF2[J+2]←SIDE; BUF2[J+3]←DELTA2;
FOR K←0 STEP 1 UNTIL 7 DO BUF2[J+K+4]←DATA[K];
$ Now make lists of team-mates and opponents;
HH←(SIDE*2)-1; JJ←SIDE-1;
GA1: FOR H←0 STEP 1 UNTIL HH DO
⊂ READB←CVXSTR(DATA[H]);
STRIP;
READX←READB;
FIND;
GA2: FOR L←8 STEP 1 UNTIL 11 DO BUF[I+L+12]←BUF[I+L];
FOR L←8 STEP 1 UNTIL 17 DO BUF[I+L]←0;
L←8; M←12;
GA3: FOR J←0 STEP 1 UNTIL HH DO
⊂ IF ((H≤JJ)∧(J≤JJ))∨((H>JJ)∧(J>JJ)) THEN
⊂ IF J≠H THEN ⊂ BUF[I+L]←DATA[J]; L←L+1; ⊃ ;
⊃ ELSE
⊂ BUF[I+M]←DATA[J]; M←M+1;
⊃ ;
⊃ ;
GA4: WHILE L≤11 DO ⊂ BUF[I+L]←0; L←L+1; ⊃ ;
WHILE M≤17 DO ⊂ BUF[I+M]←0; M←M+1; ⊃ ;
BUF[I+18]←CVSIX(READD);
⊃ ;
OUTSTR('11&"Game has been recorded. Next game please."&'15&'12&'12);
⊃ ;
⊃ "GAME";
PROCEDURE TEAMS;
⊂ INTEGER JJ;
OUTSTR('15&'12&"Date Delta Winning team Losing team"&'15&'12);
FOR J←2 STEP 12 UNTIL 1008 DO IF BUF2[J]=0 THEN DONE;
IF J<14 THEN J←14;
FOR J←J-14 STEP -12 UNTIL 0 DO
⊂ OUTSTR('15&'12);
OUTSTR(CVXSTR(BUF2[J]));
SIDE←BUF2[J+2]; JJ←SIDE-1;
OUTSTR('11&CVS(BUF2[J+3]));
OUTSTR('11);
QQ←0;
FOR K←0 STEP 1 UNTIL JJ DO
⊂ READB←CVXSTR(BUF2[J+4+K]);
STRIP; OUTSTR(READB);
IF BUF2[J+5+K]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
FOR Q←QQ STEP 1 UNTIL 20 DO OUTSTR(" "); OUTSTR(" ");
FOR K←SIDE STEP 1 UNTIL 7 DO
⊂ READB←CVXSTR(BUF2[J+4+K]);
STRIP; OUTSTR(READB);
IF BUF2[J+5+K]=0 THEN DONE; OUTSTR(","); QQ←QQ+1;
⊃ ;
⊃ ;
OUTSTR('15&'12&'12);
⊃ ;
PROCEDURE NLIST;
⊂ "NLIST"
OUTSTR("Nickn. Games Rating Name"&'15&'12);
FOR I←0 STEP SIZE UNTIL 1000 DO
⊂ IF BUF[I]=0 THEN DONE;
OUTSTR('15&'12);
RATING←BUF[I+7]; RATING←RATING/100-100;
OUTSTR(CVXSTR(BUF[I]));
SETFORMAT(3,0);
OUTSTR('11&CVS(BUF[I+6]));
SETFORMAT(5,2);
OUTSTR('11&CVF(RATING)); OUTSTR('11);
FOR K←2 STEP 1 UNTIL 5 DO OUTSTR(CVSTR(BUF[I+K]));
⊃ ;
OUTSTR('15&'12&'12&'12);
⊃ "NLIST";
PROCEDURE GLIST;
⊂ "GLIST"
⊃ "GLIST";
PROCEDURE LIKELY;
⊂ INTEGER II,JJ,KK,LL;
INTEGER ARRAY DATA2[0:64];
LABEL LI1,LI2,LI3;
OUTSTR('12&'12&'11&'11&"Bowling on the Green"&'15&'12&'12);
OUTSTR("Name Likely suggestions for people to play");
FOR I←0 STEP SIZE UNTIL BSIZE DO
⊂ "ILOOP" $ Consider each person on the list;
IF BUF[I]=0 THEN DONE;
FOR II←0 STEP SIZE UNTIL BSIZE DO
⊂ "IILOOP" $ Make up 2 lists of the other players;
IF BUF[II]=0 THEN DONE;
J←II%SIZE; IF I≠II THEN DATA[J]←DATA2[J]←BUF[II] ELSE DATA[J]←DATA2[J]←0;
⊃ "IILOOP";
LI1: JJ←J; $ JJ contains the total number of players;
FOR J←2 STEP 12 UNTIL BSIZE DO IF BUF2[J]=0 THEN DONE;
$ Now start with the most recent game;
OUTSTR('15&'12);
FOR J←J-12 STEP -12 UNTIL 2 DO
⊂ "JLOOP" $ Consider the games one at a time, backwards;
SIDE←BUF2[J];
IF SIDE=0 THEN CONTINUE; $ There is an error somewhere;
$ Check winning sides;
FOR K←1 STEP 1 UNTIL SIDE DO
⊂ "KWLOOP"
LI2: IF BUF2[J+K+1]≠BUF[I] THEN CONTINUE ELSE
$ for team-mates;
⊂ FOR LL←1 STEP 1 UNTIL SIDE DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA[L]=BUF2[J+LL+1] THEN
⊂ DATA[L]←0; DONE; ⊃ ;
⊃ ;
$ and for opponents;
FOR LL←SIDE+1 STEP 1 UNTIL SIDE*2 DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA2[L]=BUF2[J+LL+1] THEN
⊂ DATA2[L]←0; DONE; ⊃ ;
⊃ ;
⊃ ;
⊃ "KWLOOP";
$ Check losing sides;
FOR K←SIDE+1 STEP 1 UNTIL SIDE*2 DO
⊂ "KLLOOP"
LI3: IF BUF2[J+K+1]≠BUF[I] THEN CONTINUE ELSE
$ for team-mates;
⊂ FOR LL←SIDE+1 STEP 1 UNTIL SIDE*2 DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA[L]=BUF2[J+LL+1] THEN
⊂ DATA[L]←0; DONE; ⊃
⊃ ;
$ and for opponents;
FOR LL←1 STEP 1 UNTIL SIDE DO
⊂ IF BUF2[J+LL+1]=0 THEN DONE;
FOR L←0 STEP 1 UNTIL JJ DO IF DATA2[L]=BUF2[J+LL+1] THEN
⊂ DATA2[L]←0; DONE; ⊃
⊃ ;
⊃ ;
⊃ "KLLOOP";
⊃ "JLOOP";
OUTSTR('15&'12&CVXSTR(BUF[I]));
OUTSTR('15&'12&"With ");
KK←0;
FOR L←0 STEP 1 UNTIL JJ DO
⊂ IF KK≥9 THEN ⊂ OUTSTR('15&'12&'11); KK←0; ⊃;
IF DATA[L]≠0 THEN
⊂ OUTSTR(CVXSTR(DATA[L])); OUTSTR(" "); KK←KK+1; ⊃ ;
⊃ ;
OUTSTR('15&'12&"Against ");
KK←0;
FOR L←0 STEP 1 UNTIL JJ DO
⊂ IF KK≥9 THEN ⊂ OUTSTR('15&'12&'11); KK←0; ⊃;
IF DATA2[L]≠0 THEN
⊂ OUTSTR(CVXSTR(DATA2[L])); OUTSTR(" "); KK←KK+1; ⊃ ;
⊃ ;
⊃ "ILOOP";
OUTSTR('15&'12&'12);
⊃ ;
COMMENT $CLASS FATAL NONFATAL CATCRLF OPENFILE USETOUT USETIN BK!PRV;
ENTRY BAIL,B!;
BEGIN "BILGE"
REQUIRE "[][]" DELIMITERS;
REQUIRE 64 STRING!PDL; COMMENT STANDARD IS 40;
LET DEFINE=REDEFINE;
COMMENT INSTALLATION DEPENDENT MACROS AND SETTINGS.
STANFORD sets STANFO on, DEC off
DEC sets STANFO off, DEC on
TENEX taken care of automatically by testing for GTJFN;
IFCR DECLARATION(GTJFN)
THENC DEFINE TENX(A)=[A], NOTENX(A)=[], STANFO(A)=[], DEC(A)=[];
ELSEC DEFINE TENX(A)=[], NOTENX(A)=[A]; ENDC;
IFCR EQU(COMPILER!BANNER[LENGTH(SCANC(COMPILER!BANNER,"-",NULL,"IA"))+1 FOR 8]
,"TYMSHARE") THENC
DEFINE TYMSW(A)=[A],NOTYMSW(A)=[]; ELSEC
DEFINE TYMSW(A)=[],NOTYMSW(A)=[A]; ENDC
NOTENX([ DEFINE DEC(A)=[], STANFO(A)=[A]; ])
STANFO([DEFINE CH!SETC=['176],CH!ALT=['175]; COMMENT RIGHT BRACE, ALTMODE;
DEFINE CORE!IMAGE!EXTENSION=["DMP"];
DEFINE MAX#TXTFIL=[31];
REQUIRE "
STANFORD VERSION" MESSAGE;
])
DEC([ DEFINE CH!SETC=['175],CH!ALT=['33];
DEFINE CORE!IMAGE!EXTENSION=["SAV"];
DEFINE MAX#TXTFIL=[31];
NOTYMSW([REQUIRE "
DEC TOPS-10 VERSION" MESSAGE;])
TYMSW([ REQUIRE "
TYMSHARE VERSION" MESSAGE;])
])
TENX([ DEFINE CH!SETC=['175],CH!ALT=['33];
DEFINE CORE!IMAGE!EXTENSION=["SAV"];
DEFINE MAX#TXTFIL=[99];
REQUIRE "
TENX VERSION" MESSAGE;
])
DEFINE HAND(A)=[A], NOHAND(A)=[];
DEFINE FUTURE(A)=[],PAST(A)=[];
DEFINE UPTO=[STEP 1 UNTIL], #=[COMMENT], CRLF=[('15 & '12)], LF=['12],TAB=['11];
DEFINE SUPERCOMMENT(A)=[];
DEFINE CHECK(A)=[NOW!UNSAFE A],NOCHECK(A)=[NOW!SAFE A];
DEFINE MEMLOC(A,B)=[MEMORY[LOCATION(A),B]];
DEFINE LEFT(A)=[((A) LSH -18)], RIGHT(A)=[((A) LAND '777777)];
DEFINE P=['17], SP=['16],
ATJRST=['254020000000],ARERR=['007000000000],FIX=['003000000000];
DEFINE JRSTF=['254100000000],!JBDDT=['74],!JBOPC=['130],!JBSYM=['116],
!JBHRL=['115],HALT=[JRST 4,];
DEFINE PD!NPW=[4],PD!DSP=[5],PD!DLW=[7],PD!PPD=['11],PD!PCW=['12];
EXTERNAL INTEGER !SKIP!,!ERRP!,!ERRJ!,BALNK;
INTEGER !RECOVERY!,#ERRP#,#SKIP#;
EXTERNAL INTEGER PDLNK;
EXTERNAL SAFE INTEGER ARRAY GOGTAB[0:'300];
REQUIRE NOTENX(["SYS:GOGTAB.DEF"]) TENX(["<SAIL>GOGTAB.DEF"]) SOURCE!FILE;
SUPERCOMMENT([
# ABOVE REQUIRE IS MOSTLY A TEST OF THE NEW WAY TO DO AWAY WITH USERCON.
GOGTAB.DEF IS PRODUCED BY SCISS WHEN A NEW LIBRARY IS MADE, AND CONTAINS
DEFINITIONS OF THE USER TABLE ENTRY NAMES AND THEIR VALUES. IF THE FILE
IS NOT AROUND, TRY THESE:
DEFINE REMCHR=['12],TOPBYT=['11],UUO1=['0],BKTPRV=['34];
STANFO([DEFINE RACS=['135],BAILOC=['243];])
DEC([DEFINE RACS=['133],BAILOC=['241];])
TENX([DEFINE RACS=['133],BAILOC=['246];])
]) # END SUPERCOMMENT;
EXTERNAL RECORD!CLASS $CLASS(INTEGER RECRNG,HNDLER,RECSIZ;
INTEGER ARRAY TYPARR; STRING ARRAY TXTARR);
SIMPLE PROCEDURE FATAL(STRING A); USERERR(0,0,A);
SIMPLE PROCEDURE NONFATAL(STRING A); USERERR(0,1,A);
NOTENX([
DEFINE CFILE(A)="RELEASE(A)";
FORWARD SIMPLE STRING PROCEDURE CATCRLF(STRING A);
EXTERNAL INTEGER INIACS;
STRING RUNDEV,RUNPPN; # set from INIACS if RUN or GET;
SIMPLE INTEGER PROCEDURE OPENFILE(REFERENCE STRING FILNAM; STRING MODES);
BEGIN "OPENFILE"
# like TENEX-SAIL, extended if errors;
EXTERNAL INTEGER !SKIP!;
INTEGER CHN,FLAG,R,W,E,TRIAL; LABEL BAD,TRY,TRY2; STRING DEV,FIL;
PRESET!WITH
"no such file ", "illegal PPN ", "protection ", "busy ", "???";
OWN SAFE STRING ARRAY REASON[0:4];
IF (CHN←GETCHAN)<0 THEN GOTO BAD;
QUICK!CODE SETZM TRIAL; END;
TRY: DEV←"DSK";
TRY2:
START!CODE LABEL LOOP1,LOOP2,TEST1,TEST2,USEDFLT;
SETZB 1,2; # R,W;
SETZM E;
HRRZ 3,-1(SP); # LENGTH(MODES);
MOVE 5,(SP); # BP;
JRST TEST1;
LOOP1:ILDB 4,5;
CAIN 4,"R";
MOVEI 1,2(1);
CAIN 4,"W";
MOVEI 2,2(2);
CAIN 4,"E";
SETOM E;
TEST1:SOJGE 3,LOOP1;
MOVEM 1,R;
MOVEM 2,W;
MOVEI 4,FIL; # FIL←FILNAM;
MOVE 5,-1(P); # ADDR(FILNAM);
HRRZ 1,-1(5); # LENGTH(FILNAM);
MOVEM 1,-1(4);
MOVE 2,(5); # BP;
MOVEM 2,(4);
JRST TEST2;
LOOP2:ILDB 3,2;
CAIE 3,":";
TEST2:SOJGE 1,LOOP2;
JUMPL 1,USEDFLT; # NO COLON, USE DEFAULT;
EXCH 1,-1(4); # 1←ORIG LEN, -1(4)←LEN OF NAME;
EXCH 2,(4); # 2←DEV BP, (4)←NAME BP;
MOVEI 3,DEV;
MOVEM 2,(3); # DEVICE BP TO CORE;
SUB 1,-1(4); # LEN+1 OF DEV=ORIG LEN - LEN OF NAME;
SUBI 1,1; # CORRECT FOR COLON;
MOVEM 1,-1(3); # LENGTH TO CORE;
USEDFLT:SETZM FLAG;
END;
RELEASE(CHN); OPEN(CHN,DEV,'10,R,W,FLAG,FLAG,FLAG); IF FLAG THEN GOTO BAD;
IF W THEN ENTER(CHN,FIL,!SKIP!) ELSE
IF R THEN LOOKUP(CHN,FIL,!SKIP!);
IF !SKIP! AND TRIAL=0 THEN BEGIN
# try harder; IF LENGTH(RUNDEV) THEN DEV←RUNDEV; CVFIL(FIL,TRIAL,FLAG);
IF NOT(FLAG) THEN
# originally, no PPN; FILNAM←FILNAM&RUNPPN; QUICK!CODE SETOM TRIAL; END;
GOTO TRY2 END;
IF !SKIP! AND NOT(E) THEN BEGIN
OUTSTR("
File error, "&REASON[RIGHT(!SKIP!) MIN 4]& DEV&":"&FIL& "
Try again, ALT to ignore:");
CLRBUF; STANFO([PTOSTR(0,DEV&":"&FIL);])
FILNAM←INCHWL; IF !SKIP! NEQ CH!ALT THEN GOTO TRY END;
RETURN(CHN);
BAD: CFILE(CHN); RETURN(!SKIP!←TRUE);
END "OPENFILE";
]); # NOTENX;
TENX([ DEFINE USETOUT(CHAN,BLOCK)=[USETO(CHAN,BLOCK)],
USETIN(CHAN,BLOCK)=[USETI(CHAN,BLOCK)];
]) # TENX;
NOTENX([
STANFO([ DEFINE USETOUT(CHAN,BLOCK)=[USETO(CHAN,BLOCK)],
USETIN(CHAN,BLOCK)=[USETI(CHAN,BLOCK)];
]); # STANFO;
DEC([
SIMPLE PROCEDURE USETOUT(INTEGER CHAN,BLOCK); BEGIN
START!CODE
HRLZ 1,CHAN;
LSH 1,5;
TLO 1,'067000; # MAKE AN "OUTPUT" INSTRUCTION;
XCT 1; # FORCE OUT PARTIAL BUFFER;
END;
USETO(CHAN,BLOCK); END;
SIMPLE PROCEDURE USETIN(INTEGER CHAN,BLOCK); BEGIN
# THIS IS MORE COMPLICATED, SINCE WE MAY HAVE TO FLUSH SEVERAL BUFFERS;
START!CODE
DEFINE ICOWNT=['12],BUFHED=[2]; LABEL TOPP,NOBUF;
EXTERNAL INTEGER CHNCDB;
HRLZ 1,CHAN;
LSH 1,5;
IOR 1,['10+('047 LSH 27)]; # CALLI 10, WAIT;
XCT 1; # WAIT TILL DISK STOPS;
PUSH P,CHAN;
PUSHJ P,CHNCDB; # AC! GETS ADDR OF CHAN DATA BLOCK;
SETZM ICOWNT(1); # SO SAIL WILL DO AN IN NEXT TIME;
HRRZ 3,BUFHED(1); # ADDR OF INPUT BUFFER HEADER;
JUMPE 3,NOBUF;
HRRZ 2,(3); # AC2=BUFFER POINTED TO BY HEADER;
MOVEI 3,(2); # AC3=BUFFER IN WHICH TO CLEAR USE BIT;
MOVSI 4,'400000; # BIT TO CLEAR;
TOPP: ANDCAM 4,(3); # CLEAR BIT;
HRRZ 3,(3); # NEXT BUFFER;
CAIE 2,(3); # SAME AS FIRST?;
JRST TOPP; # NO;
NOBUF: END;
USETI(CHAN,BLOCK); END;
# ALL THIS IS NECESSARY BECAUSE THE DEC UUOs DO NOT FLUSH THE BUFFER,
WHILE STANFORD IS NICE AND DOES;
]) # DEC;
]) # NOTENX;
# SPECIAL BREAKTABLE STUFF;
DEFINE DELIMS=[('00 & '11 & '12 & '13 & '14 & '15 & '40)];
# NULL,TAB,LF,VT,FF,CR,SP;
# Dot (period) must be last for BK!ID2. Can save space by not mentioning
lowercase because BK!ID and BK!ID2 convert to upper first ("K" mode);
DEFINE LETTERS=["ABCDEFGHIJKLMNOPQRSTUVWXYZ!" & "αβπλ⊂⊃∀∃→_~#$\|."],
DIGITS=["0123456789"], SAILID=[(DIGITS & LETTERS)],
NUMBER=[(DIGITS & ".@")];
# THE ASCII FOR THOSE STANFORD CHARACTERS UNDER LETTERS IS:
002 (ALPHA), 003 (BETA), 007 (PI), 010 (LAMBDA),
020 (SUBSET), 021 (REVERSE SUBSET), 024 (FOR ALL), 025 (THERE EXISTS)
030 (UNDERSCORE), 031 (RIGHT ARROW), 032 (TILDE);
DEFINE QUOTE=['042];
PRESET!WITH
TAB,NULL,"INS",
DELIMS,NULL,"XNR",
QUOTE,NULL,"INA",
"01234567",NULL,"XNR",
NUMBER,NULL,"XNR",
".@",NULL,"INR",
SAILID,NULL,"XNRK";
SAFE STRING ARRAY BK!SBR[0:6,0:2]; # SETBREAK WILL BE DONE WITH THESE;
PRELOAD!WITH [8]0;
SAFE INTEGER ARRAY BK!TBL[0:7]; # TABLE NUMBERS STORED HERE;
DEFINE BK!TAB=[BK!TBL[0]],BK!DLM=[BK!TBL[1]],BK!QUO=[BK!TBL[2]],
BK!OCT=[BK!TBL[3]],BK!NUM=[BK!TBL[4]],BK!DEC=[BK!TBL[5]],BK!ID=[BK!TBL[6]],
BK!ID2=[BK!TBL[7]];
# tab,delimiters,quote,octal digits,floating decimal,
decimal digits,identifiers,ids without period;
# EXTERNAL INTEGER BKTPRV; # BREAKTABLE PRIVILEGE WORD;
SIMPLE INTEGER PROCEDURE BK!PRV(BOOLEAN MODE);
# USERCON(BKTPRV,MODE,TRUE);
BEGIN GOGTAB[BKTPRV] SWAP MODE; RETURN(MODE) END;
# SETS BREAKTABLE PRIVILEGE;
DEFINE SM1LNK(I)=[MEMORY[SM1PNT+I]], T!NAME(I)=[MEMORY[C!NAME+I]],
T!BLKADR(I)=[MEMORY[C!BLKADR+I]], T!CRDIDX(I)=[MEMORY[C!CRDIDX+I]];
DEFINE PAGEIT(A,B)=[T!NAME(B)];
DEFINE N!CACHE=[100], BOTTOM!SLOT=[95], N!BK=[16], L!BK=[(N!BK-1)];
DEFINE HRELOC(A)=[(A+HZERO)], LRELOC(A)=[(A+LZERO)];
INTEGER BAIJFN,TMPJFN; # CHANNEL NUMBERS FOR .BAI FILE AND TEXT FILES;
INTEGER C!NAME, # ADDRESS OF NAME TABLE;
C!BLKADR, # ADDRESS OF BLKADR TABLE;
C!CRDIDX, # ADDRESS OF COORDINATE INDEX TABLE;
L!NAME, # INDEX OF LAST ENTRY CURRENTLY USED IN NAME TABLE;
L!BLKADR, # BLKADR TABLE;
L!CACHE, # CACHE;
L!CRDIDX, # COORDINATE INDEX;
L!TXTFIL, # TEXTFILE TABLE;
N!NAME, # NUMBER OF ENTRIES ALLOCATED IN NAME TABLE;
N!BLKADR, # BLKADR;
N!CRDIDX # COORDINATE INDEX;
;
INTEGER BKLEV; # BREAKPOINT RECURSION LEVEL;
INTEGER PJPBAIL; # CONTAINS PUSHJ P,BAIL AT RUNTIME;
INTERNAL STRING !!QUERY; # TO BE SET BY USER ON EXPLICIT CALL TO BAIL;
INTEGER BAILOFF,NAME!POINTER; # ANOTHER SWITCH, USETI POINTER TO NAME TABLE IN .BAI FILE;
STRING ARRAY T!TXTFIL[0:MAX#TXTFIL]; # NAMES OF TEXT FILES;
PRELOAD!WITH [MAX#TXTFIL+1] 0;
INTEGER ARRAY STATUS[0:MAX#TXTFIL]; # FOR STATUS OF THESE FILES;
PRELOAD!WITH [N!CACHE] 0;
INTEGER ARRAY CACHE[0:N!CACHE-1]; # 20 MOST RECENT NAMES (5 WORDS PER);
PRELOAD!WITH [256] 0;
INTEGER ARRAY TARRAY[0:255]; # TEMPORARY ARRAY;
PRELOAD!WITH [N!BK] 0;
INTERNAL INTEGER ARRAY BK!LOC, BK!INSTR,BK!COUNT[0:L!BK];
# BREAK LOCATIONS, SAVED INSTRUCTIONS, MULTIPLE PROCEED COUNTS;
INTERNAL STRING ARRAY BK!COND,BK!ACT,BK!NAME[0:L!BK];
# TO BE EVALUATED FOR CONDITIONAL BREAK, AUTOMATIC ACTION. ID;
PRELOAD!WITH ['17+'12+1+1+1] 0;
INTEGER ARRAY TEMP!ACS[0:'17+'12+1+1]; # HOLDING TANK UNTIL RECURSIVE SAIVING;
PRELOAD!WITH [8] 0;
INTEGER ARRAY TRAP[0:8]; # PLACE TO DO INTERCEPTIONS;
STRING !STR!; # GLOBAL ACCUMULATOR FOR PIECE-WISE OUTPUT;
BOOLEAN SSF; # SPECIAL STRING FLAG, TRUE→NO QUOTE-IZE;
INTEGER MULDEF; # FALSE→TOTALLY UNKNOWN, TRUE→MULTIPLY DEFINED;
INTEGER TLDEPTH;
PRELOAD!WITH [16] 0;
INTEGER ARRAY TLSCOPE[0:15]; # KLUGE FOR TFIND;
INTEGER CRDCTR; # "GLOBAL" COUNTER OF COORDINATE NUMBERS;
PRELOAD!WITH ["G"-"A"] NULL," !!GO;",["P"-"H"] NULL," !!GO;",
["S"-"Q"] NULL," !!STEP;",["X"-"T"] NULL," !!GSTEP;",["Z"-"Y"+1] NULL;
INTERNAL SAFE STRING ARRAY MACTAB["A":"Z"]; # MACRO TABLE;
INTEGER PRGSM1; # ptr to "main program" on .SM1 BALNK chain;